Résumé statistique et analyses uni et bi-variées de la base

Author

MATTE Angelo, PITTION Eli

Published

May 20, 2025

Cette synthèse présentes les résultats de l’analyse visuelle de 309 affiches conservées entre les fonds des Archives nationales de France à Paris et la bibliothèque du Trinity College à Dublin. Cette étude a pour objectif l’examen des caractéristiques techniques et des altérations des affiches observées afin de déterminer la possible corrélation entre typologie d’affiche, mode d’affichage et altérations en présence.

Code
library(plotly) ## Pour faire des plots interactifs
library(knitr)

data_brute <- read.csv2("data_brute/data_brute_final.csv")
data_brute$Fonds[data_brute$Fonds == "Ellenberger (CP/78AJ/67)"] <- "Ellenberger"

n_doc_par_fonds <- data.frame(Fonds = unique(data_brute$Fonds),
                              nb_doc = tapply(data_brute$id.unique,
                                              data_brute$Fonds,
                                              FUN = length))

# encrassement
encrassement <- data_brute[, c("id.unique",
                                "Fonds",
                                "Encrassement")]

ss_encrassement <- encrassement[encrassement$Encrassement == "sans" , ]
avc_encrassement <- encrassement[encrassement$Encrassement %in% c("oui",
                                                                   "verso",
                                                                   "recto-verso",
                                                                   "recto") , ]

# depot
depot <- data_brute[, c("id.unique",
                        "Fonds",
                        "dépôt")]

ss_depot <- depot[depot$dépôt == "0" , ]
avc_depot <- depot[depot$dépôt == "oui" , ]


# taches
taches<- data_brute[, c("id.unique",
                        "Fonds",
                        "Taches")]

ss_tache <- taches[taches$Taches == "sans" , ]
avc_tache <- taches[taches$Taches == "oui" , ]


# aureoles
aureole <- data_brute[, c("id.unique",
                        "Fonds",
                        "auréole")]


ss_aureole <- aureole[aureole$auréole == "0" , ]
avc_aureole <- aureole[aureole$auréole == "oui" , ]

# trace de colle

trace_colle <- data_brute[, c("id.unique",
                              "Fonds",
                              "Traces.de.colle")]

ss_trace_colle <- trace_colle[trace_colle$Traces.de.colle == "sans" , ]
avc_trace_colle <- trace_colle[trace_colle$Traces.de.colle %in% c("recto-verso",
                                                                  "verso",
                                                                  "recto") , ]

lacunes <- data_brute[, c("id.unique",
                              "Fonds",
                              "Lacunes")]


# lacunes
ss_lacunes <- lacunes[lacunes$Lacunes == "sans" , ]
avc_lacunes <- lacunes[lacunes$Lacunes %in% c("oui",
                                              "comblées",
                                              "consolidées") , ]

# perforation
perforation <- data_brute[, c("id.unique",
                              "Fonds",
                              "Perforation")]

ss_perforation <- perforation[perforation$Perforation == "" , ]
avc_perforation <- perforation[perforation$Perforation == "oui" , ]

# déchirure

dechirure <- data_brute[, c("id.unique",
                              "Fonds",
                              "Déchirures")]



ss_dechirure <- dechirure[dechirure$Déchirures == "sans" , ]
avc_dechirure <- dechirure[dechirure$Déchirures == "oui" , ]

# plis
plis <- data_brute[, c("id.unique",
                              "Fonds",
                              "Présence.de.plis")]


ss_plis <- plis[plis$Présence.de.plis == "0" , ]
avc_plis <- plis[plis$Présence.de.plis == "oui" , ]

# gondolement
gondolement <- data_brute[, c("id.unique",
                              "Fonds",
                              "gondolements..affichage.")]


ss_gondolement <- gondolement[gondolement$gondolements..affichage. == "sans" , ]
avc_gondolement <- gondolement[gondolement$gondolements..affichage. == "oui" , ]

# delamination
delamination <- data_brute[, c("id.unique",
                              "Fonds",
                              "délamination")]

ss_delamination <- delamination[delamination$délamination == "sans" , ]
avc_delamination <- delamination[delamination$délamination == "oui" , ]

# coupure
coupure <- data_brute[, c("id.unique",
                              "Fonds",
                              "Coupure")]

ss_coupure <- coupure[coupure$Coupure == "0" , ]
avc_coupure <- coupure[coupure$Coupure == "oui" , ]

# abrasion
abrasion <- data_brute[, c("id.unique",
                              "Fonds",
                              "abrasion")]

ss_abrasion <- abrasion[abrasion$abrasion == "0" , ]
avc_abrasion <- abrasion[abrasion$abrasion == "oui" , ]


# migration d'encre
fuse <- data_brute[, c("id.unique",
                              "Fonds",
                              "média.qui.fuse")]

ss_fuse <- fuse[fuse$média.qui.fuse == "0" , ]
avc_fuse <- fuse[fuse$média.qui.fuse == "oui" , ]

1 Présentation de la base

1.1 Nombre de documents par fonds

Code
plot_ly(n_doc_par_fonds,
        x = ~Fonds,
        y = ~nb_doc,
        color = ~Fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents par fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

1.2 Mode d’affichage

Code
mode_affichage <- rbind(data_brute$Mode.d.affichage.1,
                        data_brute$Mode.d.affichage.2)

df_mode_affichage <- data.frame(table(mode_affichage))


affichees <- df_mode_affichage[df_mode_affichage$mode_affichage != 0 , ]

kable(affichees,
      col.names = c("Mode d'affichage", "Nombre de documents"))
Mode d’affichage Nombre de documents
2 colle 123
3 perforation 22
4 ruban adhésif 76
Code
cat("Nombre total de documents affichés : " ,sum(affichees$Freq),"\n",
round((sum(affichees$Freq)*100)/nrow(data_brute),2), "% de la base")
Nombre total de documents affichés :  221 
 71.52 % de la base

1.3 Medias

1.3.1 Type de média

Type de média Fréquence
crayon 1
encre 6
encre d’imprimerie 156
encre de sérigraphie 91
encre manuscrite 19
marqueur 30
média manuscrit 3
peinture 2
sérigraphie 1
Type de média Fréquence
0 276
encre 1
encre d’imprimerie 12
encre de sérigraphie 2
encre manuscrite 9
marqueur 1
peinture 6
stylo 2
Type de média Fréquence
? 1
0 306
encre d’imprimerie 1
stylo 1

1.3.2 Couleur des medias

Code
couleurs <- c("bleu", "jaune", "lie de vin", "marron", "noir", "orange",
              "rose", "rouge", "vert", "violet", "rouge fluo", "brun")

liste_df <- list()
nb_couleur <- c(7, 2, 2)

for (i in 1:3){
  # Sélection des colonnes pertinentes
  colonnes <- c(paste0("Type.de.média.", i),
                paste0("Couleur.", 1:nb_couleur[i], ".du.média.", i))
  
  temp_couleur_par_media <- data_brute[, colonnes]
  
  # On rassemble toutes les colonnes de couleur dans un seul vecteur
  couleurs_media <- unlist(temp_couleur_par_media[, -1])  # on exclut Type.de.média
  
  couleurs_media <- as.character(couleurs_media)

  # Filtrer les couleurs valides
  couleurs_filtrees <- couleurs_media[couleurs_media %in% couleurs]
  
  # Compter les fréquences
  temp_count <- as.data.frame(table(couleurs_filtrees))
  names(temp_count) <- c("couleur", "frequence")
  
  # Stocker dans la liste
  liste_df[[i]] <- temp_count
}

# Initialiser un tableau avec toutes les couleurs
result <- data.frame(couleur = couleurs)

# Ajouter les fréquences de chaque média
for (i in 1:3) {
  # Fusionner avec le tableau de référence
  result <- merge(result, liste_df[[i]], by = "couleur", all.x = TRUE, sort = FALSE)
  
  # Renommer la colonne de fréquence ajoutée
  names(result)[ncol(result)] <- paste0("frequence_media_", i)
}

# Remplacer les NA par 0 (pour les couleurs absentes)
result[is.na(result)] <- 0


kable(result)
couleur frequence_media_1 frequence_media_2 frequence_media_3
bleu 74 5 1
noir 157 26 1
rouge 138 16 1
orange 8 1 0
jaune 10 1 0
marron 24 1 0
vert 46 1 0
rouge fluo 0 1 0
rose 14 1 0
lie de vin 5 0 0
brun 0 0 0
violet 5 0 0

1.4 Couleur de surface

Code
couleur_surface <- data_brute$couleur.de.surface

table_couleur_surface <- table(couleur_surface)

kable(table_couleur_surface,
      col.names = c("Couleur de surface", "Nombre d'affiche"))
Couleur de surface Nombre d’affiche
? 1
blanc 272
bleu 4
jaune 17
noir 2
orange 2
rose 4
rouge 2
vert 4
violet 1

1.5 Remplois

Code
remplois <- data_brute[, c("id.unique",
                           "Fonds",
                           "affiche.issue.de.remploi")]

1.5.1 Remplois (total)

Code
table_remplois <- data.frame(table(remplois$affiche.issue.de.remploi))

                             
kable(table_remplois,
      col.names = c("Type de remplois", "Nombre de documents"))
Type de remplois Nombre de documents
affiche 6
calendrier 1
Cfdt magazine 2
formulaire 1
non 294
papier de calibrage 1
papier listing 2
papier millimétré 2
Code
table_remplois <- table_remplois[table_remplois$Var1 != "non" , ]

plot_ly(data = table_remplois,
        x = ~Var1,
        y = ~Freq,
        color = ~Var1,
        type = "bar") %>% 
  layout(title = "Nombre d'affiche issue de remplois",
         xaxis = list(title = "Type de remplois"),
         yaxis = list(title = "Nombre de document"))

1.5.2 Remplois (par fonds)

5W
Type de remplois Nombre de documents
affiche 6
Cfdt magazine 2
non 111
Ellenberger
Type de remplois Nombre de documents
calendrier 1
formulaire 1
non 117
papier de calibrage 1
papier listing 2
papier millimétré 2
Institut Charles V
Type de remplois Nombre de documents
non 53
Papyrus Case
Type de remplois Nombre de documents
non 13

2 Altérations

2.1 Altérations physico-chimiques

Code
table_ss_encrassement <- data.frame(fonds = unique(ss_encrassement$Fonds),
                                    n_doc = tapply(ss_encrassement$Fonds,
                                                        ss_encrassement$Fonds,
                                                        length))

table_avc_encrassement <- data.frame(fonds = unique(avc_encrassement$Fonds),
                                    n_doc = tapply(avc_encrassement$Fonds,
                                                        avc_encrassement$Fonds,
                                                        length))

plot_ly(table_ss_encrassement,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans encrassement (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_encrassement,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec encrassement (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_encrassement,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_encrassement$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans encrassement sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_encrassement,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_encrassement$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec encrassement sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
table_ss_depot <- data.frame(fonds = unique(ss_depot$Fonds),
                                    n_doc = tapply(ss_depot$Fonds,
                                                        ss_depot$Fonds,
                                                        length))

table_avc_depot <- data.frame(fonds = unique(avc_depot$Fonds),
                                    n_doc = tapply(avc_depot$Fonds,
                                                        avc_depot$Fonds,
                                                        length))

plot_ly(table_ss_depot,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans dépôt (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_depot,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec dépôt (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_depot,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_depot$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans dépôt sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_depot,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_depot$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec dépôt sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
table_ss_tache <- data.frame(fonds = unique(ss_tache$Fonds),
                             n_doc = tapply(ss_tache$Fonds,
                                            ss_tache$Fonds,
                                            length))

table_avc_tache <- data.frame(fonds = unique(avc_tache$Fonds),
                              n_doc = tapply(avc_tache$Fonds,
                                             avc_tache$Fonds,
                                             length))

plot_ly(table_ss_tache,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans tache (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_tache,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec tache (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_tache,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_tache$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans tache sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_tache,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_tache$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec tache sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
table_ss_aureole <- data.frame(fonds = unique(ss_aureole$Fonds),
                             n_doc = tapply(ss_aureole$Fonds,
                                            ss_aureole$Fonds,
                                            length))

table_avc_aureole <- data.frame(fonds = unique(avc_aureole$Fonds),
                              n_doc = tapply(avc_aureole$Fonds,
                                             avc_aureole$Fonds,
                                             length))

plot_ly(table_ss_aureole,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans auréole (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_aureole,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec auréole (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_aureole,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_aureole$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans auréole sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_aureole,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_aureole$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec auréole sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
table_ss_trace_colle <- data.frame(fonds = unique(ss_trace_colle$Fonds),
                             n_doc = tapply(ss_trace_colle$Fonds,
                                            ss_trace_colle$Fonds,
                                            length))

table_avc_trace_colle <- data.frame(fonds = unique(avc_trace_colle$Fonds),
                              n_doc = tapply(avc_trace_colle$Fonds,
                                             avc_trace_colle$Fonds,
                                             length))

plot_ly(table_ss_trace_colle,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans trace de colle (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_trace_colle,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec trace de colle (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_trace_colle,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_trace_colle$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans trace de colle sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_trace_colle,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_trace_colle$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec trace de colle sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

2.1.0.1 Croisement avec les autres types d’altérations

Code
avc_plis_involontaires <- data_brute[data_brute$plis.volontaires...involontaires
                                     %in% c("involontaire",
                                            "volontaire + involontaire") , 
                                     c("id.unique",
                                       "Fonds",
                                       "plis.volontaires...involontaires")]

colle_alteration_a_croiser <- list(avc_depot,
                                   avc_tache,
                                   avc_aureole,
                                   avc_delamination,
                                   avc_gondolement,
                                   avc_lacunes,
                                   avc_dechirure,
                                   avc_plis_involontaires)

ss_trace_colle_nb_croisement <- list()
avc_trace_colle_nb_croisement <- list()

for (i in 1:length(colle_alteration_a_croiser)){

ss_trace_colle_nb_croisement[[i]] <- nrow(ss_trace_colle[ss_trace_colle$id.unique %in% colle_alteration_a_croiser[[i]]$id.unique , ])
  
avc_trace_colle_nb_croisement[[i]] <- nrow(avc_trace_colle[avc_trace_colle$id.unique %in% colle_alteration_a_croiser[[i]]$id.unique , ])
  
}

croisement_colle <- data.frame(sans_trace_colle = do.call("rbind",
                                                        ss_trace_colle_nb_croisement),
                               avec_trace_colle = do.call("rbind",
                                                         avc_trace_colle_nb_croisement)
                               )

row.names(croisement_colle) <- c("dépôt",
                                 "tache",
                                 "auréole",
                                 "délamination",
                                 "gondolement",
                                 "lacune",
                                 "déchirure",
                                 "plis involontaires")

kable(croisement_colle)
sans_trace_colle avec_trace_colle
dépôt 7 19
tache 16 8
auréole 13 15
délamination 44 37
gondolement 16 45
lacune 89 62
déchirure 132 78
plis involontaires 22 11
Code
croisement_long <- reshape2::melt(as.matrix(croisement_colle))
colnames(croisement_long) <- c("Altération", "Trace de colle", "Nombre de documents")

plot_ly(data = croisement_long,
        x = ~`Trace de colle`,
        y = ~Altération,
        z = ~`Nombre de documents`,
        type = "heatmap",
        colors = colorRamp(c("white", "darkred"))) %>%
  layout(title = "Croisement entre les traces de colle et les autres altérations",
         xaxis = list(title = "Présence de trace de colle"),
         yaxis = list(title = "Altération"),
         margin = list(l = 100))

2.2 Mécanique

Code
table_ss_lacunes <- data.frame(fonds = unique(ss_lacunes$Fonds),
                               n_doc = tapply(ss_lacunes$Fonds,
                                              ss_lacunes$Fonds,
                                              length))

table_avc_lacunes <- data.frame(fonds = unique(avc_lacunes$Fonds),
                                n_doc = tapply(avc_lacunes$Fonds,
                                               avc_lacunes$Fonds,
                                               length))

plot_ly(table_ss_lacunes,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans lacune (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Code
plot_ly(table_avc_lacunes,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec lacune (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_lacunes,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_lacunes$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans lacune sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Code
plot_ly(table_avc_lacunes,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_lacunes$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec lacune sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

2.2.0.1 Situation et type de lacunes

oui
0 89 5
colle 90 33
perforation 20 0
ruban adhésif 70 2
oui
0 88 6
colle 90 33
perforation 14 6
ruban adhésif 43 29
oui
0 88 6
colle 72 51
perforation 18 2
ruban adhésif 60 12
Code
table_ss_perforation <- data.frame(fonds = unique(ss_perforation$Fonds),
                               n_doc = tapply(ss_perforation$Fonds,
                                              ss_perforation$Fonds,
                                              length))

table_avc_perforation <- data.frame(fonds = unique(avc_perforation$Fonds),
                                n_doc = tapply(avc_perforation$Fonds,
                                               avc_perforation$Fonds,
                                               length))

plot_ly(table_ss_perforation,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans perforation (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_perforation,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec perforation (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_perforation,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_perforation$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans perforation sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_perforation,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_perforation$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec perforation sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
table_ss_plis <- data.frame(fonds = unique(ss_plis$Fonds),
                               n_doc = tapply(ss_plis$Fonds,
                                              ss_plis$Fonds,
                                              length))

table_avc_plis <- data.frame(fonds = unique(avc_plis$Fonds),
                                n_doc = tapply(avc_plis$Fonds,
                                               avc_plis$Fonds,
                                               length))

plot_ly(table_ss_plis,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans plis (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_plis,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec plis (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_plis,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_plis$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans plis sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_plis,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_plis$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec plis sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

2.2.0.2 Situation et type de pli

cassé écrasé froissé tensions
0 82 1 2 9 0
colle 77 3 33 10 0
perforation 17 1 0 2 0
ruban adhésif 59 1 0 7 5
cassé écrasé froissé réseau de plis
0 75 16 0 2 1
colle 105 16 1 1 0
perforation 15 5 0 0 0
ruban adhésif 57 13 0 2 0
cassé écrasé froissé tensions
0 75 6 0 13 0
colle 108 7 3 5 0
perforation 17 2 0 1 0
ruban adhésif 58 8 0 5 1
Code
table_ss_gondolement <- data.frame(fonds = unique(ss_gondolement$Fonds),
                               n_doc = tapply(ss_gondolement$Fonds,
                                              ss_gondolement$Fonds,
                                              length))

table_avc_gondolement <- data.frame(fonds = unique(avc_gondolement$Fonds),
                                n_doc = tapply(avc_gondolement$Fonds,
                                               avc_gondolement$Fonds,
                                               length))

plot_ly(table_ss_gondolement,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans gondolement (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_gondolement,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec gondolement (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_gondolement,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_gondolement$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans gondolement sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_gondolement,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_gondolement$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec gondolement sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
table_ss_delamination <- data.frame(fonds = unique(ss_delamination$Fonds),
                               n_doc = tapply(ss_delamination$Fonds,
                                              ss_delamination$Fonds,
                                              length))

table_avc_delamination <- data.frame(fonds = unique(avc_delamination$Fonds),
                                n_doc = tapply(avc_delamination$Fonds,
                                               avc_delamination$Fonds,
                                               length))

plot_ly(table_ss_delamination,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans delamination (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_delamination,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec delamination (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_delamination,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_delamination$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans delamination sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_delamination,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_delamination$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec delamination sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
table_ss_coupure <- data.frame(fonds = unique(ss_coupure$Fonds),
                               n_doc = tapply(ss_coupure$Fonds,
                                              ss_coupure$Fonds,
                                              length))

table_avc_coupure <- data.frame(fonds = unique(avc_coupure$Fonds),
                                n_doc = tapply(avc_coupure$Fonds,
                                               avc_coupure$Fonds,
                                               length))

plot_ly(table_ss_coupure,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans coupure (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_coupure,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec coupure (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Code
# altération / Nombre de documents du fonds

plot_ly(table_ss_coupure,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_coupure$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans coupure sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_coupure,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_coupure$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec coupure sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Code
table_ss_dechirure <- data.frame(fonds = unique(ss_dechirure$Fonds),
                               n_doc = tapply(ss_dechirure$Fonds,
                                              ss_dechirure$Fonds,
                                              length))

table_avc_dechirure <- data.frame(fonds = unique(avc_dechirure$Fonds),
                                n_doc = tapply(avc_dechirure$Fonds,
                                               avc_dechirure$Fonds,
                                               length))

plot_ly(table_ss_dechirure,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans déchirure (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_dechirure,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec déchirure (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
# altération / Nombre de documents du fonds

plot_ly(table_ss_dechirure,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_dechirure$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans déchirure sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_dechirure,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_dechirure$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec déchirure sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

2.3 Etat du tracé

Code
table_ss_abrasion <- data.frame(fonds = unique(ss_abrasion$Fonds),
                               n_doc = tapply(ss_abrasion$Fonds,
                                              ss_abrasion$Fonds,
                                              length))

table_avc_abrasion <- data.frame(fonds = unique(avc_abrasion$Fonds),
                                n_doc = tapply(avc_abrasion$Fonds,
                                               avc_abrasion$Fonds,
                                               length))

plot_ly(table_ss_abrasion,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans abrasion (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_abrasion,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec abrasion (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_abrasion,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_abrasion$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans abrasion sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_abrasion,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_abrasion$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec abrasion sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Code
table_ss_fuse <- data.frame(fonds = unique(ss_fuse$Fonds),
                               n_doc = tapply(ss_fuse$Fonds,
                                              ss_fuse$Fonds,
                                              length))

table_avc_fuse <- data.frame(fonds = unique(avc_fuse$Fonds),
                                n_doc = tapply(avc_fuse$Fonds,
                                               avc_fuse$Fonds,
                                               length))

plot_ly(table_ss_fuse,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans migration d'encre (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Code
plot_ly(table_avc_fuse,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec migration d'encre (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Code
# altération / Nombre de documentss du fonds

plot_ly(table_ss_fuse,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_fuse$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans migration d'encre sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Code
plot_ly(table_avc_fuse,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_fuse$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec migration d'encre sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

2.4 Altération selon le mode d’affichage

2.4.1 Mode d’affichage (Total)

Code
### Table de fréquence mode d'affichage ~ altération (global)

mode_affichage_alteration <- data_brute[ , c("id.unique",
                                             "Mode.d.affichage.1",
                                             "Mode.d.affichage.2",
                                             "Fonds")]

mode_affichage <- unique(mode_affichage_alteration$Mode.d.affichage.1)

affichage_alteration_a_croiser <- list(avc_depot,
                                 avc_tache,
                                 avc_aureole,
                                 avc_delamination,
                                 avc_gondolement,
                                 avc_lacunes,
                                 avc_dechirure,
                                 avc_plis_involontaires)

test <- data.frame(table(data_brute$Fonds,
      data_brute$Traces.de.colle,
      data_brute$auréole))

croisement_mode_alteration <- list()

for (i_mode in mode_affichage){
  
    temp_mode <- c(mode_affichage_alteration[mode_affichage_alteration$Mode.d.affichage.1 == i_mode , "id.unique"],
                       mode_affichage_alteration[mode_affichage_alteration$Mode.d.affichage.2 == i_mode
                                  & mode_affichage_alteration$Mode.d.affichage.2 != "0" , "id.unique"]) 
  temp_croisement <- list()

  for (i in 1:length(affichage_alteration_a_croiser)){
  
  temp_croisement[[i]] <- sum(temp_mode %in% affichage_alteration_a_croiser[[i]]$id.unique)
    
  }
  croisement_mode_alteration <- cbind(croisement_mode_alteration,
                                      temp_croisement)
}

croisement_mode_alteration <- data.frame(croisement_mode_alteration)


row.names(croisement_mode_alteration) <- c("dépôt",
                                           "tache",
                                           "auréole",
                                           "délamination",
                                           "gondolement",
                                           "lacune",
                                           "déchirure",
                                           "plis involontaires")

colnames(croisement_mode_alteration) <- mode_affichage
colnames(croisement_mode_alteration)[colnames(croisement_mode_alteration) == 0] <- "sans affichage"

kable(croisement_mode_alteration)
colle sans affichage ruban adhésif perforation
dépôt 22 3 1 0
tache 9 14 0 1
auréole 26 0 1 1
délamination 61 6 14 0
gondolement 56 3 2 0
lacune 94 16 36 7
déchirure 109 36 53 16
plis involontaires 22 2 8 1
Code
### Puis par fonds

2.4.2 Mode d’affichage par fonds

Croisement pour le fonds: 5W
colle sans affichage ruban adhésif perforation
dépôt 10 3 0 0
tache 5 2 0 0
auréole 2 0 1 1
délamination 12 2 4 0
gondolement 33 2 2 0
lacune 28 8 16 5
déchirure 35 21 23 13
plis involontaires 1 0 0 0
Croisement pour le fonds: Ellenberger
colle sans affichage ruban adhésif perforation
dépôt 3 0 0 0
tache 2 12 0 1
auréole 1 0 0 0
délamination 3 3 10 0
gondolement 1 0 0 0
lacune 7 7 19 2
déchirure 15 14 29 3
plis involontaires 0 1 8 1
Croisement pour le fonds: Institut Charles V
colle sans affichage ruban adhésif perforation
dépôt 8 0 1 0
tache 2 0 0 0
auréole 11 0 0 0
délamination 36 1 0 0
gondolement 21 1 0 0
lacune 47 1 1 0
déchirure 46 1 1 0
plis involontaires 20 1 0 0
Croisement pour le fonds: Papyrus Case
colle sans affichage ruban adhésif perforation
dépôt 1 0 0 0
tache 0 0 0 0
auréole 12 0 0 0
délamination 10 0 0 0
gondolement 1 0 0 0
lacune 12 0 0 0
déchirure 13 0 0 0
plis involontaires 1 0 0 0

2.5 Altération selon le type de média principal

Code
media_alteration <- data_brute[ , c("Type.de.média.1",
                                  "qualification.de.la.perte.de.cohésion..adhésion")]
kable(t(table(media_alteration$Type.de.média.1,
      media_alteration$qualification.de.la.perte.de.cohésion..adhésion)))
crayon encre encre d’imprimerie encre de sérigraphie encre manuscrite marqueur média manuscrit peinture sérigraphie
0 1 6 139 89 19 30 2 2 1
écaillage 0 0 12 0 0 0 0 0 0
écaillage, pulvérulence 0 0 1 1 0 0 0 0 0
perte 0 0 2 1 0 0 0 0 0
perte 0 0 1 0 0 0 0 0 0
perte liée aux délaminations 0 0 1 0 0 0 0 0 0
pulvérulence 0 0 0 0 0 0 1 0 0
Code
sessionInfo()
R version 4.4.1 (2024-06-14 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 26100)

Matrix products: default


locale:
[1] LC_COLLATE=French_France.utf8  LC_CTYPE=French_France.utf8   
[3] LC_MONETARY=French_France.utf8 LC_NUMERIC=C                  
[5] LC_TIME=French_France.utf8    

time zone: Europe/Paris
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] knitr_1.48    plotly_4.10.4 ggplot2_3.5.1

loaded via a namespace (and not attached):
 [1] gtable_0.3.5       jsonlite_1.8.9     dplyr_1.1.4        compiler_4.4.1    
 [5] Rcpp_1.0.13        tidyselect_1.2.1   stringr_1.5.1      tidyr_1.3.1       
 [9] scales_1.3.0       yaml_2.3.10        fastmap_1.2.0      plyr_1.8.9        
[13] R6_2.5.1           generics_0.1.3     htmlwidgets_1.6.4  tibble_3.2.1      
[17] munsell_0.5.1      pillar_1.9.0       RColorBrewer_1.1-3 rlang_1.1.4       
[21] utf8_1.2.4         stringi_1.8.4      xfun_0.47          lazyeval_0.2.2    
[25] viridisLite_0.4.2  cli_3.6.3          withr_3.0.2        magrittr_2.0.3    
[29] crosstalk_1.2.1    digest_0.6.37      grid_4.4.1         rstudioapi_0.16.0 
[33] lifecycle_1.0.4    vctrs_0.6.5        evaluate_1.0.3     glue_1.8.0        
[37] data.table_1.16.0  farver_2.1.2       fansi_1.0.6        colorspace_2.1-1  
[41] reshape2_1.4.4     rmarkdown_2.28     purrr_1.0.2        httr_1.4.7        
[45] tools_4.4.1        pkgconfig_2.0.3    htmltools_0.5.8.1